home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / pascal / totsrc11.zip / TOTSYS.PAS < prev    next >
Pascal/Delphi Source File  |  1993-05-04  |  15KB  |  667 lines

  1. {               Copyright 1991 TechnoJock Software, Inc.               }
  2. {                          All Rights Reserved                         }
  3. {                         Restricted by License                        }
  4.  
  5. {                             Build # 1.10                             }
  6.  
  7. Unit totSYS;
  8. {$I TOTFLAGS.INC}
  9.  
  10. {
  11.  Development History:
  12.              03/15/91  1.00a   Changed DesqView checks
  13.              02/03/92  1.00b   Changed tDate to tOSDate (conflicted with TotDate)
  14.              12/15/92  1.10    DPMI update
  15. }
  16.  
  17. INTERFACE
  18.  
  19. uses DOS, CRT;
  20.  
  21. TYPE
  22. tVideo = (UnKnown, Mono, CGA, MCGAMono, MCGACol, EGAMono, EGACol, VGAMono, VGACol);
  23. tOSDate = (USA,Europe,Japan);
  24.  
  25. pDisplayOBJ = ^DisplayOBJ;
  26. DisplayOBJ = object
  27.    vSnowProne : boolean;     {does system suffer from snow}
  28.    vWidth : byte;            {no. of characters of display}
  29.    vDepth: byte;             {no. of lines of display}
  30.    vBaseOfScreen: pointer;   {location of video memory}   {5.00a}
  31.    vDisplayType: tVideo;     {video display type}
  32.    vForceBW: boolean;        {uses monochrome color schemes}
  33.    {methods...}
  34.    constructor Init;
  35.    function    TestVideo: tVideo;
  36.    function    SnowProne: boolean;
  37.    function    GetMode: byte;
  38.    function    ColorOn: boolean;
  39.    function    Width: byte;
  40.    function    Depth: byte;
  41.    function    DisplayType: tVideo;
  42.    procedure   SetCondensed;
  43.    procedure   SetBW(on:boolean);
  44.    procedure   Set25;
  45.    function    BaseOfScreen:pointer;        {returns ptr to video memory}
  46.    destructor  Done;
  47. end; {DisplayOBJ}
  48.  
  49. pEquipOBJ = ^EquipOBJ;
  50. EquipOBJ = object
  51.    vMainInfo: word;
  52.    vComputerID: byte;
  53.    vRomDate: string[8];
  54.    {methods...}
  55.    constructor Init;
  56.    function    ComputerID: byte;
  57.    function    ParallelPorts: byte;
  58.    function    SerialPorts: byte;
  59.    function    FloppyDrives: byte;
  60.    function    ROMDate: string;
  61.    function    GameAdapter: boolean;
  62.    function    SerialPrinter: boolean;
  63.    function    MathChip: boolean;
  64.    destructor  Done;
  65. end; {EquipOBJ}
  66.  
  67. pMemOBJ = ^MemOBJ;
  68. MemOBJ = object
  69.    vMemInfo: word;
  70.    vMaxExtMem: word;
  71.    vMaxExpMem: word;
  72.    vEMMInstalled: boolean;
  73.    vEMMmajor: byte;
  74.    vEMMminor: byte;
  75.    {methods...}
  76.    constructor Init;
  77.    function    BaseMemory: integer;
  78.    function    EMMInstalled: boolean;
  79.    function    EMMVersionMajor: byte;
  80.    function    EMMVersionMinor: byte;
  81.    function    EMMVersion: string;
  82.    function    MaxExtMem: word;
  83.    function    MaxExpMem: word;
  84.    function    ExtMemAvail: word;
  85.    function    ExpMemAvail: word;
  86.    destructor  Done;
  87. end; {MemOBJ}
  88.  
  89. pOSOBJ = ^OSOBJ;
  90. OSOBJ = object  {Operating System}
  91.    vMajor: byte;
  92.    vMinor: byte;
  93.    vCountry: word;
  94.    vDateFmt: tOSDate;
  95.    vCurrency: string[5];
  96.    vThousands: byte;
  97.    vDecimal: byte;
  98.    vDateSeparator: byte;
  99.    vTimeSeparator: byte;
  100.    vTimeFmt: byte;
  101.    vCurrencyFmt: byte;
  102.    vCurrencyDecPlaces: byte;
  103.    {methods...}
  104.    constructor Init;
  105.    function OSVersionMajor: byte;
  106.    function OSVersionMinor: byte;
  107.    function OSVersion: string;
  108.    function Country: word;
  109.    function Currency: string;
  110.    function DateFmt: tOSDate;
  111.    function TimeFmt: byte;
  112.    function ThousandsSep: char;
  113.    function DecimalSep: char;
  114.    function DateSep: char;
  115.    function TimeSep: char;
  116.    function CurrencyFmt: byte;
  117.    function CurrencyDecPlaces: byte;
  118.    destructor  Done;
  119. end; {OSOBJ}
  120.  
  121. procedure sysINIT;
  122.  
  123. VAR
  124.   Monitor: ^DisplayObj;
  125.  
  126. IMPLEMENTATION
  127. {||||||||||||||||||||||||||||||||||||}
  128. {                                    }
  129. {     D I S P L A Y    S T U F F     }
  130. {                                    }
  131. {||||||||||||||||||||||||||||||||||||}
  132. constructor DisplayObj.Init;
  133. {}
  134. var
  135.    Mode : byte;
  136.    Regs: Registers;
  137. begin
  138.    vDisplayType := TestVideo;
  139. (* Disabled due to driver conflicts
  140.    with Regs do
  141.    begin
  142.       AX := $2B01;       {1.00a DesqViewTest}
  143.       CX := $4445;
  144.       DX := $5351;
  145.       intr($21,Regs);
  146.       if Al <> $FF then {DesqView present}
  147.       begin
  148.          Ah := $FE;
  149.          Intr($10,Regs);
  150.          vBaseOfScreen := ptr(ES,DI);
  151.       end
  152.       else
  153.       begin
  154.          Mode := GetMode;
  155.          if Mode = 7 then
  156.             vBaseOfScreen := ptr($B000,0)  {Mono}
  157.          else
  158.             vBaseOfScreen := ptr($B800,0); {Color}
  159.       end;
  160.    end;
  161. *)
  162.    Mode := GetMode;
  163. {$IFDEF DPMI}                 {1.10}
  164.    if Mode = 7 then
  165.       vBaseOfScreen := ptr(segB000,0)  {Mono}
  166.    else
  167.       vBaseOfScreen := ptr(segB800,0); {Color}
  168. {$ELSE}
  169.    if Mode = 7 then
  170.       vBaseOfScreen := ptr($B000,0)  {Mono}
  171.    else
  172.       vBaseOfScreen := ptr($B800,0); {Color}
  173. {$ENDIF}
  174.    vSnowProne := (vDisplayType = CGA);
  175.    vWidth := 80;
  176.    vDepth := succ(Hi(WindMax));
  177.    vForceBW := false;
  178. end; {DisplayObj.Init}
  179.  
  180. function DisplayOBJ.TestVideo: tVideo;
  181. {}
  182. var
  183.    Regs: Registers;
  184.    Equip: byte;
  185.    Temp: tVideo;
  186. begin
  187.    with Regs do
  188.    begin
  189.       Al := $00;
  190.       Ah := $1A;   {get VGA info}
  191.       Intr($10,Regs);
  192.       if Al = $1A then
  193.          case Bl of
  194.          $00: Temp := unknown;
  195.          $01: Temp := Mono;
  196.          $04: Temp := EGACol;
  197.          $05: Temp := EGAMono;
  198.          $07: Temp := VGAMono;
  199.          $08: Temp := VGACol;
  200.          $0A,
  201.          $0C: Temp := MCGACol;
  202.          $0B: Temp := MCGAMono;
  203.          else
  204.             Temp := CGA;
  205.          end {case}
  206.       else         {more checking needed}
  207.       begin
  208.          Ah := $12;
  209.          BX := $10;  {get EGA data}
  210.          Intr($10,Regs);
  211.          if BX = $10 then {EGA or Mono}
  212.          begin
  213.              Intr($11,Regs);
  214.              if ((Al and $30) shr 4) = 3 then
  215.                 Temp := Mono
  216.              else
  217.                 Temp := CGA;
  218.          end
  219.          else 
  220.          begin
  221.              Ah := $12;
  222.              BX := $10;  {one more time!}
  223.              Intr($10,Regs);
  224.              if Bh = 0 then
  225.                 Temp := EGACol
  226.              else
  227.                 Temp := EGAMono;
  228.          end;  {if}
  229.       end; {if}
  230.    end; {with}
  231.    TestVideo := Temp;
  232. end; {DisplayOBJ.TestVideo}
  233.  
  234. function DisplayObj.GetMode;
  235. {}
  236. var Regs : registers;
  237. begin
  238.    with Regs do
  239.    begin
  240.       Ax := $0F00;
  241.       Intr($10,Regs);  {get video display mode}
  242.       GetMode := Al;
  243.    end;
  244. end; {DisplayObj.GetMode}
  245.  
  246. function DisplayObj.ColorOn: boolean;
  247. {}
  248. begin
  249.    if (vForceBW)
  250.    or (DisplayType in [Mono, MCGAMono, EGAMono, VGAMono])
  251.    or (GetMode = 2) then       {Mode BW80 active}
  252.       ColorOn := False
  253.    else
  254.       ColorOn := true;
  255. end; {DisplayObj.ColorOn}
  256.  
  257. procedure DisplayOBJ.SetBW(On:boolean);
  258. {}
  259. begin
  260.    vForceBW := On;
  261. end; {DisplayOBJ.SetBW}
  262.  
  263. function DisplayObj.BaseOfScreen: pointer;
  264. {}
  265. begin
  266.     BaseofScreen := vBaseOfScreen; {1.00a}
  267. end; {DisplayObj.BaseOfScreen}
  268.  
  269. function DisplayObj.SnowProne: boolean;
  270. {}
  271. begin
  272.    SnowProne := vSnowProne;
  273. end; {DisplayObj.SnowProne}
  274.  
  275. function DisplayObj.Width: byte;
  276. {}
  277. begin
  278.    Width := vWidth;
  279. end; {DisplayObj.Width}
  280.  
  281. function DisplayObj.Depth: byte;
  282. {}
  283. begin
  284.    Depth := vDepth;
  285. end; {DisplayObj.Depth}
  286.  
  287. function DisplayObj.DisplayType: tVideo;
  288. {}
  289. begin
  290.     DisplayType := vDisplayType;
  291. end; {DisplayObj.DisplayType}
  292.  
  293. procedure DisplayObj.SetCondensed;
  294. {sets to maximum number od display lines supported by the display system}
  295. begin
  296.    if vDisplayType in [EGAMono,EGACol,VGAMono,VGACol] then
  297.    begin
  298.       TextMode(Lo(LastMode)+Font8x8);
  299.       vDepth := succ(Hi(WindMax));
  300.    end;
  301. end; {DisplayObj.SetCondensed}
  302.  
  303. procedure DisplayObj.Set25;
  304. {resets display back to 25 lines}
  305. begin
  306.    if Depth <> 25 then
  307.    begin
  308.       TextMode(Lo(LastMode));
  309.       vDepth := succ(Hi(WindMax));
  310.    end;
  311. end; {DisplayObj.Set25}
  312.  
  313. destructor DisplayObj.Done;
  314. begin end;
  315.  
  316. {||||||||||||||||||||||||||||||||||||}
  317. {                                    }
  318. {       E Q U I P    S T U F F       }
  319. {                                    }
  320. {||||||||||||||||||||||||||||||||||||}
  321.  
  322. constructor EquipOBJ.Init;   {1.10}
  323. {}
  324. var
  325.   Reg: registers;
  326.   IDPtr: pointer;
  327.   ROMPtr: pointer;
  328. begin
  329.    intr($11,Reg);
  330.    vMa